home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 3: The Continuation / 17-Bit_The_Continuation_Disc.iso / amigan / amigan 9 / automata / source / automata.mod < prev   
Encoding:
Text File  |  1994-01-27  |  4.9 KB  |  194 lines
  1. MODULE Automata;
  2.  
  3. (*  Automata is the main two-dimensional cellular automata calculator 
  4.     program, implementing all the features given to it by the Byte,
  5.     December 1986 article.  
  6.     
  7.     Version 1.1a  by Mike Dryja   March 1, 1987  *)
  8.     
  9. FROM SYSTEM     IMPORT NULL;
  10. FROM AMCalc     IMPORT MaxAutomata, Automata, RuleString, Range, Same,
  11.                        Equate, NextGeneration, Initialize, CloseCalc,
  12.                SetLength, EstablishRule; 
  13. FROM AMSetUp    IMPORT AMWindow, PrepareScreen, CloseSetUp, NewRule, OldRule,
  14.                        StringReq, AuthorReq;
  15. FROM AMMenu     IMPORT InitMenu, Toggle, ToggleChoices;
  16. FROM AMGraphics IMPORT ScrollType, SetScroll, PreparePlot, PlotAutomata;
  17. FROM Intuition  IMPORT IDCMPFlags, IDCMPFlagSet, IntuiMessage,
  18.                        IntuiMessagePtr;
  19. FROM Ports      IMPORT GetMsg, ReplyMsg, Message, MessagePtr, WaitPort;
  20. FROM IntuiUtils IMPORT ItemNum, MenuNum;
  21. FROM Requesters IMPORT Request;
  22. FROM Strings    IMPORT Assign;
  23. FROM InOut      IMPORT WriteString, WriteLn;
  24. FROM RandomNumbers
  25.         IMPORT Random;
  26. TYPE
  27.   Normal = ARRAY[1..MaxAutomata] OF CHAR;
  28.  
  29. VAR
  30.   FirstA,
  31.   SecondA      : Automata;
  32.   ScrollStatus : ScrollType;
  33.   FirstAStr    : Normal;
  34.   ReStart,
  35.   AllDone      : BOOLEAN;
  36.   MsgPtr       : IntuiMessagePtr;
  37.   Class        : IDCMPFlagSet;
  38.   Code         : CARDINAL;
  39.     
  40. PROCEDURE RandomAutomata (VAR auto : Normal);
  41. VAR
  42.   i : CARDINAL;
  43. BEGIN
  44.   FOR i := 1 TO MaxAutomata DO
  45.     auto[i] := CHR(48 + Random(4));
  46.   END;
  47. END RandomAutomata;
  48.  
  49. PROCEDURE RequestRule();
  50. VAR
  51.   RuleMsgPtr : IntuiMessagePtr;
  52. BEGIN
  53.   IF Request(StringReq^, AMWindow^) = TRUE THEN
  54.     REPEAT
  55.       RuleMsgPtr := WaitPort(AMWindow^.UserPort);
  56.       RuleMsgPtr := GetMsg(AMWindow^.UserPort);
  57.     UNTIL (RuleMsgPtr^.Class = (IDCMPFlagSet {ReqClear}));
  58.     ReplyMsg(MessagePtr(RuleMsgPtr));
  59.     Assign(OldRule, NewRule);
  60.     EstablishRule(NewRule);
  61.   END;
  62. END RequestRule;
  63.  
  64. PROCEDURE RequestAuthor();
  65. VAR
  66.   AuthorMsgPtr : IntuiMessagePtr;
  67. BEGIN
  68.   IF Request(AuthorReq^, AMWindow^) = TRUE THEN
  69.     REPEAT
  70.       AuthorMsgPtr := WaitPort(AMWindow^.UserPort);
  71.       AuthorMsgPtr := GetMsg(AMWindow^.UserPort);
  72.     UNTIL (AuthorMsgPtr^.Class = (IDCMPFlagSet {ReqClear}));
  73.     ReplyMsg(MessagePtr(AuthorMsgPtr));
  74.   END;
  75. END RequestAuthor;
  76.  
  77. PROCEDURE PauseAutomata();
  78. VAR
  79.   PauseMsgPtr : IntuiMessagePtr;
  80.   TogBack     : BOOLEAN;
  81. BEGIN
  82.   TogBack := FALSE;
  83.   Toggle (Resume);
  84.   REPEAT
  85.     REPEAT
  86.       PauseMsgPtr := WaitPort(AMWindow^.UserPort);
  87.       PauseMsgPtr := GetMsg(AMWindow^.UserPort);
  88.     UNTIL (PauseMsgPtr^.Class = (IDCMPFlagSet {MenuPick}));
  89.     ReplyMsg(MessagePtr(PauseMsgPtr));
  90.     IF MenuNum(PauseMsgPtr^.Code) = 1 THEN
  91.       IF (ItemNum(PauseMsgPtr^.Code)) = 0 THEN
  92.         ScrollStatus := Coarse;
  93.         SetScroll(ScrollStatus);
  94.       ELSE
  95.         ScrollStatus := Smooth;
  96.         SetScroll(ScrollStatus);
  97.       END;
  98.     ELSIF MenuNum(PauseMsgPtr^.Code) = 0 THEN
  99.       CASE (ItemNum(PauseMsgPtr^.Code)) OF
  100.         0 : RequestAuthor;                  |
  101.     1 : RequestRule;                    |
  102.     2 : TogBack := TRUE;                |
  103.     3 : ReStart := TRUE;
  104.         TogBack := TRUE;                |
  105.     4 : AllDone := TRUE;
  106.         TogBack := TRUE;                |
  107.       END;
  108.     END;
  109.   UNTIL (TogBack = TRUE);
  110.   Toggle (Pause);
  111. END PauseAutomata;
  112.  
  113. PROCEDURE DoMessage();
  114. BEGIN
  115.   IF Class = (IDCMPFlagSet {MenuPick}) THEN
  116.     IF MenuNum(Code) = 1 THEN
  117.       IF (ItemNum(Code)) = 0 THEN
  118.         ScrollStatus := Coarse;
  119.         SetScroll(ScrollStatus);
  120.       ELSE
  121.         ScrollStatus := Smooth;
  122.         SetScroll(ScrollStatus);
  123.       END;
  124.     ELSIF MenuNum(Code) = 0 THEN
  125.       CASE (ItemNum(Code)) OF
  126.         0 : RequestAuthor;                  |
  127.     1 : RequestRule;                    |
  128.     2 : PauseAutomata;                  |
  129.     3 : ReStart := TRUE;                |
  130.     4 : AllDone := TRUE;                |
  131.       END;
  132.     END;
  133.   END;
  134. END DoMessage;
  135.  
  136. BEGIN
  137.   
  138.   (*  One time initializations first  *)
  139.   
  140.   IF PrepareScreen() = FALSE THEN
  141.     WriteString("Could not prepare screen."); WriteLn;
  142.     CloseSetUp();
  143.     CloseCalc();
  144.     HALT();
  145.   END;
  146.   InitMenu();
  147.   SetLength(MaxAutomata);
  148.   Initialize(FirstA);
  149.   Initialize(SecondA);
  150.   NewRule := "0231123003";   
  151.   Assign(OldRule, NewRule);
  152.   ScrollStatus := Coarse;
  153.   SetScroll(ScrollStatus);
  154.   AllDone := FALSE;
  155.   EstablishRule(NewRule);
  156.         
  157.   (*  Main loop  *)
  158.   
  159.   REPEAT
  160.     PreparePlot();
  161.     RandomAutomata(FirstAStr);
  162.     Equate(FirstAStr, FirstA);
  163.  
  164.     LOOP
  165.       PlotAutomata(FirstA);
  166.       Same(FirstA, SecondA);
  167.       NextGeneration(SecondA, FirstA);
  168.       MsgPtr := GetMsg(AMWindow^.UserPort);
  169.       IF MsgPtr # NULL THEN
  170.         WHILE MsgPtr # NULL DO
  171.       Class := MsgPtr^.Class;
  172.       Code := MsgPtr^.Code;
  173.       ReplyMsg(MessagePtr(MsgPtr));
  174.       DoMessage();
  175.       MsgPtr := GetMsg(AMWindow^.UserPort);
  176.     END;
  177.     IF ReStart = TRUE THEN
  178.       ReStart := FALSE;
  179.       EXIT;
  180.     END;
  181.         IF AllDone = TRUE THEN
  182.       EXIT;
  183.     END;
  184.       END;
  185.     END;
  186.   UNTIL AllDone = TRUE;
  187.  
  188.   (*  Close everything down  *)
  189.   
  190.   CloseSetUp();
  191.   CloseCalc();
  192. END Automata.
  193.  
  194.